Questionnaire Preparations: Cognitive Control and Motivated Reasoning

Data cleaning, data checks, scale caluclations, and some further preparations for analyses specific of the questionnaire data.

# use groundhog to make code maximally reproducible
if (!require("groundhog", quietly = TRUE)) {
  install.packages("groundhog")
}
library("groundhog")

# use groundhog to install and load packages
pkgs <- c("here",         # System path management
          "tidyverse",    # ggplot, dplyr, %>%, and friends
          "tinytable",    # Lightweight package to create tables
          "modelsummary", # Data and model summaries with tables and plots
          "pandoc",       # Required for saving tables as docx
          "MBESS",        # Mix of functions including reliability
          "hrbrthemes",   # Additional ggplot themes
          "extrafont",    # Additional fonts for plots etc
          "showtext",     # So that fonts also work on mac
          "patchwork",    # Combine ggplot objects
          "corrplot",     # Correlation plots
          "lavaan"        # Required for reliability calculation
          )

groundhog.library(pkgs, "2024-07-01") 

Data Preparations

Add the same subj_idx as from the gng_task to the raw data.

data_id <- data_raw %>%
  left_join(id_table, by = "Participant Private ID")

# check if it worked
id_check <- data_id %>%
  select(`Participant Private ID`, subj_idx) %>%
  distinct() 

head(id_check)

# A tibble: 6 × 2
  `Participant Private ID` subj_idx
                     <dbl>    <dbl>
1                 11693545      252
2                 11693585        1
3                 11693590      382
4                 11693627      253
5                 11693677        2
6                 11693710      255

Convert data types

# Define the levels
items_levels_order <- c("Strongly disagree", "Disagree", "Neutral", "Agree", "Strongly agree")

data_converted <- data_id %>% 
  mutate(across(
    .cols = c(o_immigration:dog11), 
    .fns = ~ str_replace_all(.x, "Strongly Agree", "Strongly agree") %>%
             factor(levels = items_levels_order, ordered = TRUE)
  ))

# Define the levels
ideo_levels_order <- c("Extremely left", "Left", "Slightly left", 
                       "Moderate",
                       "Slightly right", "Right", "Extremely right")

gender_order <- c("female", "male", "__other")

data_converted <- data_converted %>% 
  mutate(ideology = factor(ideology, levels = ideo_levels_order, ordered = TRUE),
         gender = factor(gender, levels = gender_order, ordered = FALSE)) %>% 
  mutate(gender = fct_recode(gender, "other" = "__other"))

data_converted <- data_converted %>% 
  mutate(
    ideology_num = case_when(
      ideology == "Extremely left" ~ 1,
      ideology == "Left" ~ 2,
      ideology == "Slightly left" ~ 3,
      ideology == "Moderate" ~ 4,
      ideology == "Slightly right" ~ 5,
      ideology == "Right" ~ 6,
      ideology == "Extremely right" ~ 7,
      TRUE ~ NA_real_  
    )) 

Calculate variables

Education ISCED Level

• ISCED 0-2 is anything up to GCSE

• ISCED 3-4 is anything up to A-levels

• ISCED 5-8 is anything in higher education (BSc, MSc, Doctoral degree and so on)

data_scores <- data_converted %>%
  mutate(edu_group = case_when(
    education %in% c("Primary school", "Secondary school up to 16 years (GCSEs or equivalent)") ~ "ISCED 0-2",
    education == "Higher secondary or further education (A-levels, T-levels, BTEC, International Baccalaureate or equivalent)" ~ "ISCED 3-4",
    education %in% c("Bachelors degree (BA, BSc., BEd., BEng.)", 
                     "Masters Degree, M.Phil, Post-Graduate Diplomas and Certificates", 
                     "Ph.D, D.Phil or equivalent") ~ "ISCED 5-8",
    education %in% c("__other") ~ "Other",
    TRUE ~ "Other"
  ))  %>%
  mutate(edu_group = factor(edu_group, levels = c("ISCED 0-2", "ISCED 3-4", "ISCED 5-8", "Other"), ordered = FALSE))

Age group

data_scores <- data_scores %>%
  mutate(age_group = case_when(
    age_corrected >= 18 & age_corrected <= 24 ~ "18-24",
    age_corrected >= 25 & age_corrected <= 31 ~ "25-31",
    age_corrected >= 32 ~ "Above 32",
    TRUE ~ "Other"
    ),
    age_group = factor(age_group, levels = c("18-24", "25-31", "Above 32", "Other"), ordered = FALSE)
  )

Attention check

Participants passed the attention check when they selected “Strongly agree”.

data_scores <- data_scores %>% 
  mutate(questionnaire_attention_check = 
           case_when(attention_check == "Strongly agree" ~ "passed",
                     attention_check != "Strongly agree" ~ "failed"))

Score of Cognitive Reflection Test

• crt1 correct answer is 4 years

• crt2 correct answer is 10 seconds

• crt3 correct answer is 39 days

correct_answers <- list(crt1 = 4, crt2 = 10, crt3 = 39)

data_scores <- data_scores %>% 
  rowwise() %>%
  mutate(
    crt_correct = sum(
      crt1 == correct_answers$crt1,
      crt2 == correct_answers$crt2,
      crt3 == correct_answers$crt3
    )
  ) %>%
  ungroup()

Sum score of Dogmatism Scale

Transform items to numeric

data_numeric <- data_scores %>%
  mutate(across(
    .cols = c(dog01, dog02, dog03, dog04, dog05,  
              dog06, dog07, dog08, dog09, 
              dog10, dog11),
    .fns = as.numeric
  ))

Recode items dog02, dog04, dog05, dog07, dog08, dog09

# Reverse code relevant dog items
data_numeric <- data_numeric %>%
  mutate(
    dog02_r = 6 - dog02,
    dog04_r = 6 - dog04,
    dog05_r = 6 - dog05,
    dog07_r = 6 - dog07,
    dog08_r = 6 - dog08,
    dog09_r = 6 - dog09
  )

Calculate the sum score

data_scores <- data_numeric %>%
  rowwise() %>%
  mutate(dogmatism = sum(c_across(c(dog01, dog02_r, dog03, dog04_r, 
                                    dog05_r, dog06, dog07_r, dog08_r,
                                    dog09_r, dog10, dog11)), 
                         na.rm = TRUE)) %>%
  ungroup()

Calculate the reliability of the dogmatism scale

data_numeric %>% 
  select(dog01, dog02_r, dog03, dog04_r, dog05_r, 
         dog06, dog07_r, dog08_r, dog09_r, dog10, dog11) %>% 
  ci.reliability(., conf.level = 0.95, interval.type = 'mlr')

$est
[1] 0.811

$se
[1] 0.0167

$ci.lower
[1] 0.778

$ci.upper
[1] 0.843

$conf.level
[1] 0.95

$type
[1] "omega"

$interval.type
[1] "robust maximum likelihood (wald ci)"

Affective polarisation

Create a long df

data_polarisation_long <- data_numeric %>% 
  select(subj_idx, conservative_rating, labour_rating, libdem_rating, 
         green_rating, reform_rating) %>% 
  pivot_longer(
    cols = -subj_idx,                  
    names_to = "party",                
    values_to = "rating"               
  ) %>% 
  mutate(
    party = str_replace(party, "_rating", "")  # Remove "_rating" suffix
  )

Calculate affective polarisation as the spread of ratings (see https://www.sciencedirect.com/science/article/pii/S0261379420300822)

data_polarisation <- data_polarisation_long %>%
  group_by(subj_idx) %>% 
  # calculate mean of all party ratings for each subject
  mutate(
    M_rating = mean(rating, na.rm = TRUE), 
    # calculate squared difference from the mean rating for each party
    ExpDiff_rating = (rating - M_rating)^2
  ) %>% 
  reframe(
    n_valid_ratings = sum(!is.na(rating)),
    # calculate spread of ratings (affective polarization)
    affective_polarisation = ifelse(n_valid_ratings >= 2, sqrt(mean(ExpDiff_rating, na.rm = TRUE)), NA)
  ) %>%
  ungroup() %>% 
  select(subj_idx, affective_polarisation)

data_polarisation

# A tibble: 504 × 2
   subj_idx affective_polarisation
      <dbl>                  <dbl>
 1        1                   43.8
 2        2                   29.9
 3        3                   37.0
 4        4                   26.5
 5        5                   22.3
 6        6                   34.9
 7        7                   31.7
 8        8                   35.1
 9        9                   27.7
10       10                   30.4
# ℹ 494 more rows

Add it back to the data

data_scores <- data_scores %>% 
  left_join(data_polarisation, by = "subj_idx")

Code motives from issue opinion items

The motives correspond to the ones in the Fake News Game.

There are some questions that correspond to a Pro-Motive if the message in the Fake News Game is higher, and some questions that correspond to a Anti-Motive if the message in the Fake News Game is higher.

If Message in Fake News Game is Higher, then Agree / Strongly Agree on the following questions corresponds to a Higher-Motive:

• o_climate

• o_immigration

• o_punishment

• o_teaculture

• o_brain

In other words, for these questions, the values “Agree” and “Strongly Agree” should be coded as “Higher” for the variable “motive”. And the values “Disagree” and “Strongly disagree” should be coded as “Lower”. The value “Neutral” should stay as “Neutral”.

If Message in Fake News Game is Higher, then Agree / Strongly Agree on the following questions corresponds to a Lower-Motive:

• o_gender

• o_discrimination

• o_adoption

• o_selfenhancement

• o_cats

In other words, for these questions, the values “Agree” and “Strongly agree” should be coded as “Lower” for the variable “motive”. And the values “Disagree” and “Strongly disagree” should be coded as “Higher”. The value “Neutral” should stay as “Neutral”.

I want to store these motives in variables called m_[topic]

In addition, I would like to calculate the strength of motives. Disagree and Agree are strength 1, and Strongly disagree and Strongly agree are strength 2.

I want to store the strength of each motive in variables called s_[topic]

# Define the questions corresponding to Higher and Lower motives
higher_motive_questions <- c("o_climate", "o_immigration", "o_punishment", "o_teaculture", "o_brain")
lower_motive_questions <- c("o_gender", "o_discrimination", "o_adoption", "o_selfenhancement", "o_cats")

# Function to recode motives
recode_motive <- function(x, higher = TRUE) {
  case_when(
    x %in% c("Agree", "Strongly agree") & higher ~ "Higher",
    x %in% c("Disagree", "Strongly disagree") & higher ~ "Lower",
    x %in% c("Agree", "Strongly agree") & !higher ~ "Lower",
    x %in% c("Disagree", "Strongly disagree") & !higher ~ "Higher",
    x == "Neutral" ~ "Neutral",
    TRUE ~ NA_character_  
  )
}

# Function to calculate motive strength
calculate_strength <- function(x) {
  case_when(
    x %in% c("Strongly disagree", "Strongly agree") ~ 2,
    x %in% c("Disagree", "Agree") ~ 1,
    x == "Neutral" ~ NA_integer_,
    TRUE ~ NA_integer_  
  )
}

# Recode motives and calculate strengths
data_motives <- data_scores %>%
  mutate(
    across(all_of(higher_motive_questions), ~ recode_motive(.x, higher = TRUE), .names = "m_{gsub('o_', '', col)}"),
    across(all_of(lower_motive_questions), ~ recode_motive(.x, higher = FALSE), .names = "m_{gsub('o_', '', col)}"),
    across(all_of(higher_motive_questions), ~ calculate_strength(.x), .names = "s_{gsub('o_', '', col)}"),
    across(all_of(lower_motive_questions), ~ calculate_strength(.x), .names = "s_{gsub('o_', '', col)}")
  )

Code motives from ideology

Ideology item: In politics, people often talk of “Left” and “Right”. Where would you place yourself on the following scale?

1. Extremely left - 7. Extremely right

I created a new variable called “ideo_group” that codes

• Extremely left, Left and Slightly left: Left

• Extremely right, Right, and Slightly right: Right

• Moderate: Moderate

I also code the strength from 0 (Moderate) to 3 (Extreme)

The goal is now to create a variable for each issue that codes the ideology motive. As motives on non-political issues cannot be inferred using the ideology variable, I use arbitrary values for this.

if ideo_group “Left” then this variable should take the values:

• climate: “Higher”

• adoption: “Lower”

• punishment: “Lower”

• gender: “Higher”

• discrimination: “Lower”

• immigration: “Lower”

• Random placeholders for non-political

  • teaculture: “Lower”

  • brain: “Lower”

  • cats: “Lower”

if ideo_group “Right” then this variable should take the values:

• climate: “Lower”

• adoption: “Higher”

• punishment: “Higher”

• gender: “Lower”

• discrimination: “Higher”

• immigration: “Higher”

• Random placeholders for non-political

  • teaculture: “Higher”

  • brain: “Higher”

  • cats: “Higher”

If ideo_group == “Moderate” then this variable should take the values:

• “Neutral”

# Collapse ideology into groups
data_motives <- data_motives %>%
  mutate(
    ideo_group = case_when(
      ideology %in% c("Extremely left", "Left", "Slightly left") ~ "Left",
      ideology %in% c("Extremely right", "Right", "Slightly right") ~ "Right",
      ideology == "Moderate" ~ "Moderate"
    )
  )

# Create ideo_strength variable
data_motives <- data_motives %>%
  mutate(
    ideo_strength = case_when(
      ideology %in% c("Slightly left", "Slightly right") ~ 1,
      ideology %in% c("Left", "Right") ~ 2,
      ideology %in% c("Extremely left", "Extremely right") ~ 3,
      ideology == "Moderate" ~ NA_integer_ 
    )
  )

# Create ideo_m_topic variables
data_motives <- data_motives %>%
  mutate(
    ideo_m_climate = case_when(
      ideo_group == "Left" ~ "Higher",
      ideo_group == "Right" ~ "Lower",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_adoption = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_punishment = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_gender = case_when(
      ideo_group == "Left" ~ "Higher",
      ideo_group == "Right" ~ "Lower",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_discrimination = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_immigration = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_teaculture = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_brain = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
    ideo_m_cats = case_when(
      ideo_group == "Left" ~ "Lower",
      ideo_group == "Right" ~ "Higher",
      ideo_group == "Moderate" ~ "Neutral"
    ),
  )

Code performance default motive

The default motive for performance questions is “Higher” (due to self-enhancement bias).

data_motives <- data_motives %>% 
  mutate(self_m_enhancement = "Higher")

Data checks

General descriptive checks

Demographics

data_motives %>% 
  select(gender, age_group, worksit, education, edu_group, 
         ideology, partisanship, crt_correct, attention_check, attention_start, attention_end) %>% 
  mutate(across(everything(), as.factor)) %>% 
  datasummary_skim(type = "categorical")

		N	%
gender	female	215	42.7
	male	284	56.3
	other	5	1.0
age_group	18-24	167	33.1
	25-31	168	33.3
	Above 32	169	33.5
	Other	0	0.0
worksit	__other	5	1.0
	At university	93	18.5
	Employed	309	61.3
	In school	4	0.8
	Self-employed	37	7.3
	Unemployed	46	9.1
	Working in the household	10	2.0
education	__other	2	0.4
	Bachelors degree (BA, BSc., BEd., BEng.)	210	41.7
	Higher secondary or further education (A-levels, T-levels, BTEC, International Baccalaureate or equivalent)	173	34.3
	Masters Degree, M.Phil, Post-Graduate Diplomas and Certificates	72	14.3
	Ph.D, D.Phil or equivalent	4	0.8
	Primary school	1	0.2
	Secondary school up to 16 years (GCSEs or equivalent)	42	8.3
edu_group	ISCED 0-2	43	8.5
	ISCED 3-4	173	34.3
	ISCED 5-8	286	56.7
	Other	2	0.4
ideology	Extremely left	23	4.6
	Left	159	31.5
	Slightly left	83	16.5
	Moderate	23	4.6
	Slightly right	110	21.8
	Right	91	18.1
	Extremely right	15	3.0
partisanship	__other	25	5.0
	Conservative	104	20.6
	Green	64	12.7
	Labour	150	29.8
	Liberal Democrat	44	8.7
	Plaid Cymru	5	1.0
	Reform UK	96	19.0
	SNP	16	3.2
crt_correct	0	123	24.4
	1	97	19.2
	2	120	23.8
	3	164	32.5
attention_check	Strongly disagree	0	0.0
	Disagree	0	0.0
	Neutral	0	0.0
	Agree	0	0.0
	Strongly agree	504	100.0
attention_start	No	1	0.2
	Yes	503	99.8
attention_end	No	6	1.2
	Yes	496	98.4

# save it
data_motives %>% 
  select(gender, age_group, worksit, education, edu_group, 
         ideology, partisanship, crt_correct, attention_check, attention_start, attention_end) %>% 
  mutate(across(everything(), as.factor)) %>% 
  datasummary_skim(type = "categorical") %>% 
  save_tt(here("03_output", "tables", "questionnaire_factors_check.docx"), overwrite = TRUE)

Some participants reported not having been attentive. Let’s check which they are:

data_motives %>% 
  filter(attention_start != "Yes" | attention_end != "Yes") %>% 
  select(subj_idx, `Participant Private ID`, age_corrected, ideology, 
         attention_start, attention_end) %>% 
  tt()

subj_idx	Participant Private ID	age_corrected	ideology	attention_start	attention_end
40	11694553	33	Left	Yes	No
391	11694948	20	Right	Yes	No
237	11706788	23	Moderate	Yes	No
240	11707860	22	Slightly right	Yes	No
365	11694595	29	Left	Yes	No
32	11694531	33	Left	No	Yes
22	11694456	27	Left	Yes	No

Continuous variables

data_motives %>% 
  select(age_corrected, conservative_rating:reform_rating, 
         crt_correct, dogmatism, affective_polarisation) %>% 
  datasummary_skim(type = "numeric") 

	Unique	Missing Pct.	Mean	SD	Min	Median	Max	Histogram
age_corrected	24	0	28.1	6.1	18.0	28.0	51.0
conservative_rating	91	0	29.5	28.7	0.0	20.0	100.0
labour_rating	97	0	44.2	29.2	0.0	48.0	100.0
libdem_rating	92	0	42.4	24.7	0.0	44.0	100.0
green_rating	95	0	49.2	29.2	0.0	50.0	100.0
reform_rating	86	0	29.8	33.4	0.0	12.0	100.0
crt_correct	4	0	1.6	1.2	0.0	2.0	3.0
dogmatism	32	0	23.0	5.4	11.0	23.0	49.0
affective_polarisation	479	0	26.5	9.0	0.0	27.5	46.4

# save it
data_motives %>% 
  select(age_corrected, conservative_rating:reform_rating, 
         crt_correct, dogmatism, affective_polarisation) %>% 
  datasummary_skim(fun_numeric = list(Mean = Mean, 
                                      SD = SD, Min = Min, 
                                      Median = Median, 
                                      Max = Max
                                      )) %>% 
  save_tt(here("03_output", "tables", "questionnaire_continuous_check.docx"), overwrite = TRUE)

Issue motive variables

data_motives %>% 
  select(m_climate:s_cats) %>% 
  datasummary_skim(type = "categorical")

		N	%
m_climate	Higher	407	80.8
	Lower	28	5.6
	Neutral	69	13.7
m_immigration	Higher	204	40.5
	Lower	205	40.7
	Neutral	95	18.8
m_punishment	Higher	262	52.0
	Lower	164	32.5
	Neutral	78	15.5
m_teaculture	Higher	358	71.0
	Lower	28	5.6
	Neutral	118	23.4
m_brain	Higher	329	65.3
	Lower	21	4.2
	Neutral	154	30.6
m_gender	Higher	360	71.4
	Lower	78	15.5
	Neutral	66	13.1
m_discrimination	Higher	83	16.5
	Lower	366	72.6
	Neutral	55	10.9
m_adoption	Higher	102	20.2
	Lower	335	66.5
	Neutral	67	13.3
m_selfenhancement	Higher	233	46.2
	Lower	144	28.6
	Neutral	127	25.2
m_cats	Higher	111	22.0
	Lower	294	58.3
	Neutral	99	19.6

Ideology motive variables

data_motives %>% 
  select(ideo_strength:ideo_m_immigration) %>% 
  datasummary_skim(type = "categorical")

		N	%
ideo_m_climate	Higher	265	52.6
	Lower	216	42.9
	Neutral	23	4.6
ideo_m_adoption	Higher	216	42.9
	Lower	265	52.6
	Neutral	23	4.6
ideo_m_punishment	Higher	216	42.9
	Lower	265	52.6
	Neutral	23	4.6
ideo_m_gender	Higher	265	52.6
	Lower	216	42.9
	Neutral	23	4.6
ideo_m_discrimination	Higher	216	42.9
	Lower	265	52.6
	Neutral	23	4.6
ideo_m_immigration	Higher	216	42.9
	Lower	265	52.6
	Neutral	23	4.6

Correlations

# select and rename data
corr_data <- data_motives %>% 
  mutate(across(
    .cols = c(gender, edu_group, ideology, o_immigration:o_brain, o_discrimination:o_gender),  
    .fns = ~ as.numeric(.x)  # Conversion to numeric
  )) %>% 
  select(age_corrected, gender, edu_group, ideology, conservative_rating:reform_rating,
         o_immigration:o_brain, o_discrimination:o_gender, crt_correct, 
         dogmatism, affective_polarisation)

# correlation analysis
corrs <- cor(corr_data)
corrs_p <- cor.mtest(corr_data, conf.level = 0.95)

# plot it 
col <- colorRampPalette(c("#4477AA", "#77AADD", "#FFFFFF", "#EE9988", "#BB4444"))
corrplot(corrs, method="color", col=col(200),  
         type="upper", order="original", 
         addCoef.col = "black", # Add coefficient of correlation
         tl.col="black", tl.srt=45, # Text label color and rotation,
         #p.mat = corrs_p$p, sig.level = 0.05, insig = "blank", 
         diag=FALSE, number.cex=0.85 
         )

# save it
png(filename = here("03_output", "figures", "questionnaire_correlation_plot.png"), width = 12, height = 12, units = "in", res = 300)

corrplot(corrs, method="color", col=col(200),  
         type="upper", order="original", 
         addCoef.col = "black", # Add coefficient of correlation
         tl.col="black", tl.srt=45, # Text label color and rotation,
         #p.mat = corrs_p$p, sig.level = 0.05, insig = "blank", 
         diag=FALSE, number.cex=0.85 
         )

dev.off()

quartz_off_screen 
                2 

Save data frames

I will save two data frames. One includes all variables that are in data_motives, including all individual items. The other data frame only includes the items that I need for further analyses.

data_sel <- data_motives %>% 
  select(subj_idx, `Participant Private ID`, 
         age_corrected, age_group, gender, worksit, education, edu_group, 
         ideology, ideology_num, partisanship, conservative_rating:reform_rating, 
         questionnaire_attention_check, attention_start, attention_end, 
         crt_correct, dogmatism:self_m_enhancement)

# selected data
write_csv(data_sel, here("01_data", "scored", 
                         "data_questionnaire_scores_sel.csv"), 
          na = "", append = FALSE, col_names = TRUE)

# full data
write_csv(data_motives, here("01_data", "scored", 
                             "data_questionnaire_scores_all.csv"), 
          na = "", append = FALSE, col_names = TRUE)